Imports System
Imports System.io
Imports System.Runtime.InteropServices
Imports System.ComponentModel
Module modSongInfo

    Public Class WMAID3Tag
        ' This class will read all the attributes from the ContextBlock and ExtendedContextBlock in a WMA file
        ' It makes available the attributes that are most interesting directly, and allows the retrieval on any string attribute by name.
        ' Could easily be extended to allow the retrieval of non-string attributes, I just didn't need them.
        ' I couldn't find an easy way to have a resumable enumeration over a hash table (there's not items() array) I didn't 
        ' implement an enumerator.  It wouldn't be hard to do, just clumsy.
        Public title, artist, album, genre, copyright, description, rating As String
        Public year, track As Integer
        Private stream As FileStream
        Private br As BinaryReader
        Private attrs As New Hashtable
        Private attrValues As New ArrayList
        Private Structure value
            Public dataType As Int16
            Public index As Integer
        End Structure
        ' WMA GUIDs
        Private hdrGUID As Guid = New Guid("75B22630-668E-11CF-A6D9-00AA0062CE6C")
        Private contentGUID As Guid = New Guid("75B22633-668E-11CF-A6D9-00AA0062CE6C")
        Private extendedContentGUID As Guid = New Guid("D2D0A440-E307-11D2-97F0-00A0C95EA850")
        Public Sub New(ByVal fn As String)
            Dim g As Guid
            Dim CBDone, ECBDone As Boolean
            Dim sizeBlock As Long
            Dim s As String
            Dim i As Integer

            Try
                stream = New FileStream(fn, FileMode.Open, FileAccess.Read)
                br = New BinaryReader(stream)
            Catch ex As Exception
                MsgBox("Could not open " & fn)
                Return
            End Try

            readGUID(g)
            If Not Guid.op_Equality(g, hdrGUID) Then
                ' throw an exception
                Throw New Exception("Invalid WMA file format.")
            End If
            br.ReadInt64() ' the size of the entire block
            br.ReadInt32() ' the number of entries
            br.ReadBytes(2) ' two reserved bytes
            ' Process all the GUIDs until you get both the contextblock and the extendedcontextblock
            While readGUID(g)
                sizeBlock = br.ReadInt64() ' this is the size of the block
                ' shouldn't happen, but at least fail gracefully
                If br.BaseStream.Position + sizeBlock > stream.Length Then
                    Exit While
                End If
                If Guid.op_Equality(g, contentGUID) Then
                    processContentBlock()
                    If ECBDone Then
                        Exit While
                    End If
                    CBDone = True
                ElseIf Guid.op_Equality(g, extendedContentGUID) Then
                    processExtendedContentBlock()
                    If CBDone Then
                        Exit While
                    End If
                    ECBDone = True
                Else
                    ' not one we're interested in, skip it
                    sizeBlock -= 24 ' already read the guid header info
                    br.BaseStream.Position += sizeBlock
                End If
            End While

            ' Get the attributes we're interested in
            album = getStringAttribute("WM/AlbumTitle")
            genre = getStringAttribute("WM/Genre")
            s = getStringAttribute("WM/Year")
            If IsNumeric(s) Then
                year = CInt(s)
            End If
            s = getStringAttribute("WM/TrackNumber")
            ' could be n/<total>
            i = s.IndexOf("/")
            If Not i = -1 Then
                s = s.Substring(0, i)
            End If
            If IsNumeric(s) Then
                track = CInt(s)
            Else
                s = getStringAttribute("WM/Track")
                i = s.IndexOf("/")
                If Not i = -1 Then
                    s = s.Substring(0, i)
                End If
                If IsNumeric(s) Then
                    track = CInt(s)
                End If
            End If
        End Sub
        Private Function readUnicodeString(ByVal len As Int16) As String
            'Can't use .NET functions, since they expect the length field to be a single byte for strings < 256 chars
            Dim ch() As Char
            Dim i As Integer
            Dim k As Short

            ReDim ch(len - 2)
            For i = 0 To len - 2
                k = br.ReadInt16
                ch(i) = ChrW(k)
            Next
            k = br.ReadInt16
            Return New String(ch)
        End Function
        Private Function readUnicodeString() As String
            Dim datalen, len As Int16
            'Can't use .NET functions, since they expect the length field to be a single byte for strings < 256 chars
            datalen = br.ReadInt16
            len = CShort(datalen / 2) ' length in Unicode characters
            Return readUnicodeString(len)

        End Function
        Private Sub processExtendedContentBlock()
            Dim numAttrs, dataType, dataLen, sValue As Int16
            Dim attrName, strValue As String
            Dim bValue() As Byte
            Dim boolValue As Boolean
            Dim i, iValue, index As Integer
            Dim lValue As Long
            Dim valueObject As value
            Dim ch() As Char

            numAttrs = br.ReadInt16
            For i = 0 To numAttrs - 1
                attrName = readUnicodeString()
                dataType = br.ReadInt16
                Select Case dataType
                    Case 0
                        strValue = readUnicodeString()
                        valueObject.dataType = 0
                        valueObject.index = index
                        attrs.Add(attrName, valueObject)
                        attrValues.Add(strValue)
                        index += 1

                    Case 1
                        dataLen = br.ReadInt16
                        ReDim bValue(dataLen - 1)
                        bValue = br.ReadBytes(dataLen)
                        valueObject.dataType = 1
                        valueObject.index = index
                        attrs.Add(attrName, valueObject)
                        attrValues.Add(bValue)
                        index += 1

                    Case 2
                        dataLen = br.ReadInt16
                        iValue = br.ReadInt32
                        If iValue = 0 Then
                            boolValue = False
                        Else
                            boolValue = True
                        End If
                        valueObject.dataType = 2
                        valueObject.index = index
                        attrs.Add(attrName, valueObject)
                        attrValues.Add(boolValue)
                        index += 1

                    Case 3
                        dataLen = br.ReadInt16
                        iValue = br.ReadInt32
                        valueObject.dataType = 3
                        valueObject.index = index
                        attrs.Add(attrName, valueObject)
                        attrValues.Add(iValue)
                        index += 1

                    Case 4
                        dataLen = br.ReadInt16
                        lValue = br.ReadInt64
                        valueObject.dataType = 4
                        valueObject.index = index
                        attrs.Add(attrName, valueObject)
                        attrValues.Add(lValue)
                        index += 1

                    Case 5
                        dataLen = br.ReadInt16
                        sValue = br.ReadInt16
                        valueObject.dataType = 5
                        valueObject.index = index
                        attrs.Add(attrName, valueObject)
                        attrValues.Add(sValue)
                        index += 1

                    Case Else
                        Throw New Exception("Bad value for datatype in Extended Content Block. Value = " & dataType)
                End Select
            Next
        End Sub
        Private Sub processContentBlock()
            Dim lTitle, lAuthor, lCopyright, lDescription, lRating, i As Short
            Dim ch() As Char

            lTitle = br.ReadInt16
            lAuthor = br.ReadInt16
            lCopyright = br.ReadInt16
            lDescription = br.ReadInt16
            lRating = br.ReadInt16
            If lTitle > 0 Then
                i = CShort(lTitle / 2)
                title = readUnicodeString(i)
            End If
            If lAuthor > 0 Then
                i = CShort(lAuthor / 2)
                artist = readUnicodeString(i)
            End If
            If lCopyright > 0 Then
                i = CShort(lCopyright / 2)
                copyright = readUnicodeString(i)
            End If
            If lDescription > 0 Then
                i = CShort(lDescription / 2)
                description = readUnicodeString(i)
            End If
            If lRating > 0 Then
                i = CShort(lRating / 2)
                rating = readUnicodeString(i)
            End If
        End Sub
        Private Function readGUID(ByRef g As Guid) As Boolean
            Dim int1 As Integer
            Dim shrt1, shrt2 As Short
            Dim b(6) As Byte

            Try
                int1 = br.ReadInt32
                If int1 = -1 Then
                    Return False
                End If
                shrt1 = br.ReadInt16
                shrt2 = br.ReadInt16
                b = br.ReadBytes(8)
                g = New Guid(int1, shrt1, shrt2, b)
                Return True
            Catch ex As Exception
                Throw New Exception("Invalid WMA format.")
            End Try
        End Function
        Public Function getStringAttribute(ByVal name As String) As String
            Dim s As String
            Dim v As value

            If Not attrs.Contains(name) Then
                Return ""
            End If
            v = CType(attrs(name), value)
            If Not v.dataType = 0 Then
                ' it's not a string type
                Return ""
            Else
                Return CType(attrValues(v.index), String)
            End If
        End Function
    End Class
    Public Class ID3V1Tag
        Public title, artist, album, genre, comment As String
        Public year, track As Integer
        Private stream As FileStream
        Private br As BinaryReader
#Region "Genre Strings"
        Private genres() As String = {"Blues", "Classic Rock", "Country", "Dance", _
          "Disco", "Funk", "Grunge", "Hip-Hop", _
          "Jazz", "Metal", "New Age", "Oldies", _
          "Other", "Pop", "R&B", "Rap", _
          "Reggae", "Rock", "Techno", "Industrial", _
          "Alternative", "Ska", "Death Metal", "Pranks", _
          "Soundtrack", "Euro-Techno", "Ambient", "Trip-Hop", _
          "Vocal", "Jazz+Funk", "Fusion", "Trance", _
          "Classical", "Instrumental", "Acid", "House", _
          "Game", "Sound Clip", "Gospel", "Noise", _
          "Alt. Rock", "Bass", "Soul", "Punk", _
          "Space", "Meditative", "Instrumental Pop", "Instrumental Rock", _
          "Ethnic", "Gothic", "Darkwave", "Techno-Industrial", _
          "Electronic", "Pop-Folk", "Eurodance", "Dream", _
          "Southern Rock", "Comedy", "Cult", "Gangsta Rap", _
          "Top 40", "Christian Rap", "Pop/Funk", "Jungle", _
          "Native American", "Cabaret", "New Wave", "Psychedelic", _
          "Rave", "Showtunes", "Trailer", "Lo-Fi", _
          "Tribal", "Acid Punk", "Acid Jazz", "Polka", _
          "Retro", "Musical", "Rock & Roll", "Hard Rock", _
          "Folk", "Folk/Rock", "National Folk", "Swing", _
          "Fast-Fusion", "Bebop", "Latin", "Revival", _
          "Celtic", "Bluegrass", "Avantgarde", "Gothic Rock", _
          "Progressive Rock", "Psychedelic Rock", "Symphonic Rock", "Slow Rock", _
          "Big Band", "Chorus", "Easy Listening", "Acoustic", _
          "Humour", "Speech", "Chanson", "Opera", _
          "Chamber Music", "Sonata", "Symphony", "Booty Bass", _
          "Primus", "Porn Groove", "Satire", "Slow Jam", _
          "Club", "Tango", "Samba", "Folklore", _
          "Ballad", "Power Ballad", "Rhythmic Soul", "Freestyle", _
          "Duet", "Punk Rock", "Drum Solo", "A Cappella", _
          "Euro-House", "Dance Hall", "Goa", "Drum & Bass", _
          "Club-House", "Hardcore", "Terror", "Indie", _
          "BritPop", "Negerpunk", "Polsk Punk", "Beat", _
          "Christian Gangsta Rap", "Heavy Metal", "Black Metal", "Crossover", _
          "Contemporary Christian", "Christian Rock", "Merengue", "Salsa", "Thrash Metal"}
#End Region
        Public Sub New(ByVal fn As String)
            Dim ch() As Char
            Dim b As Byte
            Dim s As String

            Try
                stream = New FileStream(fn, FileMode.Open)
                br = New BinaryReader(stream)
            Catch ex As Exception
                Throw New Exception("Could not open " & fn)
                Return
            End Try

            Try
                stream.Seek(-128, SeekOrigin.End)

                ReDim ch(2)
                ch = br.ReadChars(3)
                If Not New String(ch) = "TAG" Then
                    Throw New Exception("No Valid ID3V1.1 tag information")
                    Return
                End If

                ReDim ch(29)
                ch = br.ReadChars(30)
                title = New String(ch)
                ch = br.ReadChars(30)
                artist = New String(ch)
                ch = br.ReadChars(30)
                album = New String(ch)
                ReDim ch(3)
                ch = br.ReadChars(4)
                s = New String(ch)
                If IsNumeric(s) Then
                    year = CInt(s)
                Else
                    year = 0
                End If
                ReDim ch(27)
                ch = br.ReadChars(28)
                comment = New String(ch)
                b = br.ReadByte
                b = br.ReadByte
                track = CInt(b)
                b = br.ReadByte
                genre = genres(CInt(b))
            Catch ex As Exception
                'Throw New Exception("ID3 V1.1 tag information not valid in " & fn)
            Finally
                br.Close()
                stream.Close()
            End Try
        End Sub
    End Class
End Module
